perm filename VC.FAI[TMP,LCS]1 blob
sn#557782 filedate 1981-01-18 generic text, type T, neo UTF8
00100 TITLE VCLIP ;CREATES .VRN FILES FOR VARIAN PROGRAM.
00200 ; CLIPS INTO 8" X 21" SEGMENTS WHICH 'VARIAN' REASSEMBLES.
00300 ;**** TO WRITE ON UDP1: USE DDT TO PUT IN 'JFCL' AT LABEL "UDP".
00400 ;**** TO SHIFT TO LEFT CHANGE RTEDGE TO LOWER NUM. (1 IN.=200)
00500
00600 ;**** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9 , ALSO 16
00700 ;↓↓AC DEF
00800 A←1
00900 B←2
01000 C←3
01100 D←4
01200 E←5
01300 L←6
01400 U←7
01500 X←11
01600 Y←12
01700 XD←13
01800 T←15
01900 TT←16
02000 P←17
02100
02200 LPDL←←69
02300 NBUFS←←4
02400 DSK←←1
02500 VRN←←2 ;DEVICE NAME OF VARIAN STATOS
02600
02700 LMAR←←=0
02800 RMAR←←=4299 ;WILL DO 10.2" LONG MAXIMUM
02900 WIDTH←←=4300 ;21" WIDE PAPER --
03000 LBUFL←←=120 ;LINE LENGTH IN WORDS
03100
03200 LSTBIT←←1⊗34
03300
03400 OVERLAP←←=50
03500
03600 DOFF←←-=2000
03700
03800 EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
03900 MAILBF: BLOCK 40
04000 SIGN: 0
04100 LINE: 0
04200 PNTR: 0
04300 SEG1: =1600 ;FOR 8" SEGMENT
04400 RTEDGE: =1700 ;ADJUST RTEDGE OF VRN PAPER. MAKE SMALLER TO MOVE
04500 ; IMAGE TO LEFT (200=1 INCH)
04600
04700 BEG: OUTSTR [ASCIZ /INPUT? (<CR>=PLT.PLT) /]
04800 SETZM ZLFT# ;FLAG FOR LOOKING FOR LEFTMOST POINT.
04900 SETZM NOROT ; NO-ROTATION FLAG
05000 MOVE SEG1
05100 ADDI =200
05200 MOVEM SEG2# ;SEG2 IS 200 > SEG1 (FOR SLOPING CUTOFFS)
05300 MOVEI =9999
05400 MOVEM XLFT#
05500 MOVE P,[-LPDL,,PDL-1]
05600 PUSHJ P,FRD
05700 SETZ A, ;FOR DEFAULT SEGMENT NUMBER
05800 OUTSTR [ASCIZ /TYPE SEGMENT NUMBER. (<CR>=1) /]
05900 PUSHJ P,RNUM ;THE NUMBER COMES BACK IN AC A
06000 MOVEI 1 ;KSEG=1
06100 MOVEM KSEG#
06200 SKIPG A ;IF(ISEG.EQ.0)ISEG=KSEG
06300 MOVE A,KSEG
06400 MOVEM A,KSEG ;KSEG=ISEG
06500 MOVEM A,ISEG#
06600 OUTSTR [ASCIZ /THICKNESS? <CR>=1 DOT, OR TYPE 4, 9, OR 16 /]
06700 PUSHJ P,SPRD ;GO SET UP THE SPREAD NUMBER.
06800 ; SETZ A,
06900 PUSHJ P,NAMGET ;GET OUTPUT NAME
07000 BEGX: SKIPN NOROT
07100 JRST BEGY
07200 MOVE ISEG ;IF SIZE 2.1-2.6 USE ONLY 4 SEGMENTS
07300 CAIL 5
07400 CALLI 12 ;EXIT
07500 BEGY: SKIPN ZLFT ;IS THIS THE 1ST TIME THROUGH?
07600 JRST BEGZ ;YES
07650 PUSHJ P,CORDWN
07700 MOVE RT
07800 SUBI =100 ;CHECK TO SEE IF ANY MORE SEGS TO BE DONE.
07900 SUB SEG1 ;SUBTRACT SEGMENT SIZE AND ALSO 100 (FOR SLOPES)
08000 CAMGE XLFT ;THIS IS LEFTMOST POINT IN IMAGE
08100 CALLI 12 ;ALL DONE
08200 BEGZ: SETOM LINE
08300 GETLIN LINE ;FOR ERROR PRINTOUT
08400 CALLI
08500 HRRZS LINE ;CLEAR LINE BITS
08600 HRRZI A,CORUP
08700 HRRZM A,JOBAPR
08800 SETOM SSS#
08900 HRRZ A,JOBFF ;RESET CORE WITHOUT A RESET
09000 CORE A,
09100 JRST 4,.
09200
09300 MOVEI A,20000 ;REG MPV
09400 APRENB A, ;REG ENABLE OLD WAY!
09500
09600 MOVE SPRED#
09700 MOVEM SPREAD# ;GET SPREAD (DOTS) FLAG
09800 SETOM NOVECS# ;NO-VECTORS FLAG
09900 SETZM X1
10000 SETZM Y1
10100 SETZM CX
10200 SETZM CY
10300 SETZM X3
10400 SETZM Y3
10500
10600 YAGN1: HRREI B,-60
10700 PASS2: HRREI A,-=2000
10800 YDEF: ADD A,B
10900 MOVNM A,INIX#
11000 AGAIN: MOVE A,[FILNAM,,LKENT]
11100 BLT A,LKENT+3
11200 OPEN DSK,[14↔'DSK '↔IBUF]
11300 JRST 4,.
11400 INBUF DSK,NBUFS
11500 LOOKUP DSK,LKENT
11600 JRST FNF
11700 ASKLEN: SETZM POOBX#
11800 SETZM POOBY#
11900 PUSHJ P,XINI ;GET X INFO
12000 SETZM XX#
12100 SETZM YY#
12200 MOVEI C,3
12300 HRRZM C,PENN#
12400 READ1: IN DSK, ;READ FIRST BUFFER
12500 SKIPA
12600 HALT ;ERROR
12700 HRR C,IBUF+1
12800 ;; MOVN E,1(C) ;LOOK FOR SIZE FACTOR. IF FOUND SKIP THIS BUFFER.
12900 MOVE E,1(C) ;;CAIGE E,177 ;FIRST WD HAS SIZE * 1000, NOT WDCNT
13000 PUSHJ P,SAVAC ;SAVE ALL ACS
13100 FLTR E,E ;FAC=M(1)/1000.
13200 FDVR E,[1000.0] ; SIZE FACTOR IS NOW IN FIRST WORD INSTEAD OF WORDCNT
13300 MOVEM E,FAC#
13400 MOVE 14,[2.0]
13500 FSBR 14,FAC ;E
13600 MOVEM 14,15
13700 FMPR 14,[95.542] ;IF(ISEG.EQ.0)ISEG=KSEG+1
13800 KIFIX 14,14 ; TOP=4150+(2.-FAC)*95.54
13900 ADDI 14,=4150
14000 MOVEM 14,TOP
14100 FMPR 15,[67.0] ;11 OFFX=-100.-(2.-FAC)*67
14200 KIFIX 15,15 ; THIS GIVES =5 FOR FAC=3.57, =-100 FOR FAC=2
14300 ;; ADDI 15,=100 ; ABOVE WAS =0, BUT BOTTOM LINE MISSED AT SIZE 3.57
14400 ADD 15,RTEDGE ;****** WAS 2100 TEMPORARY FIX FOR WRINKLED VRN PAPER
14500 ;; ADDI 15,=2100
14600 MOVNM 15,OFFX ; FOR SIZE FACTORS OF 3+
14700 V11: MOVE 15,ISEG ; MAKES 4150 AT SIZE 2, 4000 AT SIZE 3.57
14800 CAIG 15,=10 ; KSEG=ISEG
14900 JRST V7
15000 MOVEI 13,=7450 ; TYPE 12,ISEG,FAC
15100 MOVEM 13,TOP ;12 FORMAT(' SEGMENT=',I2,' SIZE FACTOR=',F5.2)
15200 MOVNI 13,=5450 ;IF(ISEG.LT.10)GO TO 7
15300 MOVEM 13,OFFX ; TOP=7300 +150
15400 SUBI 15,=10 ;OFFX=-3300 +150
15500 CAIG 15,=10 ; SHIFT X COORDS TO LEFT TO GET TOP 1/2 OF PAGE
15600 JRST V7 ; ISEG=ISEG-10
15700 MOVEI 13,=10600 ;IF(ISEG.LT.10)GO TO 7
15800 MOVEM 13,TOP ; NOW FOR THIRD LEVEL. FOR SIZE 5!
15900 MOVNI 13,=8600 ;TOP=10600
16000 MOVEM 13,OFFX ;OFFX=-6600
16100 SUBI 15,=10 ;ISEG=ISEG-10
16200 V7: MOVNI 13,=4200 ;7 BOT=TOP-4200
16300 ADD 13,TOP ;IF(ISEG.EQ.0)ISEG=1
16400 ; FIXED SEGSIZ 6 IN. =1200 (1400 FOR OVERLAP OF 1". TAKEN CARE OF IN V)
16500 MOVEM 13,BOT ;RT=850.*FAC+(1-ISEG)*1600
16600 MOVEM 15,ISEG
16700 SOJ 15,
16800 MOVNS 15
16900 IMUL 15,SEG1 ; 1750= 8 3/4" , PRINT OUT ONLY 8" PER SEGMENT
17000 FLTR 15,15 ;LFT=RT-1800
17100 MOVE E,FAC
17200 FMPR E,[850.0]
17300 FADR E,15
17400 KIFIX E,E
17500 MOVEM E,RT
17600 MOVEM E,OFFY ;OFFY=RT
17700 SUB E,SEG2 ;SEG2 IS INNER (REAL) SEGMENT SIZE
17800 MOVEM E,LFT
17900 MOVE E,FAC ; IF(FAC.LE.2.OR.FAC.GT.2.6)RETURN
18000 CAMLE E,[2.0] ; NEXT FOR SIZE FACTORS THAT DO BETTER WITHOUT ROTATION
18100 CAMLE E,[2.6]
18200 JRST V9 ;RT=2050
18300 MOVEI E,=2050
18400 MOVEM E,RT
18500 MOVNM E,LFT ;LFT=-RT
18600 MOVE E,SEG1 ;MAKES 8" SEGMENTS (IF SEG1=1600)
18700 IMUL E,ISEG ;TOP=ISEG*1600+100
18800 ADDI E,=100
18900 MOVEM E,TOP
19000 SUB E,SEG2 ;BOT=TOP-1600
19100 MOVEM E,BOT
19200 V10: MOVEI E,1 ;OFFY=120+(1-ISEG)*1600
19300 SUB E,ISEG
19400 IMUL E,SEG1 ;SEG1 IS OUTER SEGMENT SIZE
19500 ADDI E,=120
19600 MOVEM E,OFFY
19700 SETOM NOROT ;NOROT=-1 SET THE FLAG
19800 JRST V9
19900
20000 V9: OUTSTR [ASCIZ/
20100 SEGMENT=/]
20200 JSA 16,TYPINT
20300 JUMP KSEG
20400 OUTSTR [ASCIZ/ SIZE FACTOR=/]
20500 JSA 16,TYPFLT
20600 JUMP FAC
20700 OUTSTR [ASCIZ/
20800 /] ;ADD A CRLF
20900 PUSHJ P,GETAC ;GET BACK ALL ACS
21000 MOVNI E,177
21100 JRST PLOTX ;IF(E.LT.-177)E=-177 WDCNT FOR EACH BUFFER (128-1)
21200
21300 OUTER: IN DSK,
21400 JRST PLOT
21500 STATO DSK,20000
21600 JRST 4,.
21700 RELEAS DSK,
21800 IFN LSTBIT-1,<PUSHJ P,XFIX>
21900 SKIPLE NOVECS ;DON'T WRITE FILE IF NO VECTORS IN THIS SEGMENT.
22000 JRST XXOUT
22100 OUTSTR [ASCIZ /NO VECTORS FOUND IN THIS SEGMENT./]
22200 CALLI 12 ;EXIT
22300
22400 INCHLF: INCHWL 0 ;GET ANOTHER CHARACTER
22500 CAIE 0,12 ;WAS IT A LF?
22600 JRST INCHLF ;GET THE LF
22700 POPJ P,
22800
22900 SAVAC: MOVEM 16,ACS+16 ;SAVE AC16
23000 MOVEI 16,ACS ;ARG. FOR BLT
23100 BLT 16,ACS+15 ;WE'VE ALREADY SAVED AC16
23200 MOVE 16,ACS+16
23300 POPJ P,
23400
23500 ACS: BLOCK 17 ;SAVE AC'S 0-16
23600
23700 GETAC: HRLZI 16,ACS
23800 BLT 16,16 ;GET 'EM ALL BACK
23900 POPJ P,
00100 XINI: MOVEI A,=2000 ;THIS IS MAXIMUM FOR THIS PROGRAM(255K)
00200 XDEF: MOVEM A,LINCNT#
00300 MOVEI B,-1(A)
00400 IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
00500 MOVE T,JOBFF ;GET START ADDR
00600 MOVEM T,XGPPTR
00700 SOS XGPPTR
00800 MOVEI T,2(A)
00900 MOVNI TT,(T)
01000 ADD T,XGPPTR
01100 HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
01200 MOVE TT,T
01300
01400 HRRZ L,XGPPTR
01500 MOVSI T,1(L)
01600 HRRI T,2(L)
01700 SETZM 1(L)
01800 MOVE U,JOBREL
01900 BLT T,(U) ;ZERO TO END OF CORE
02000 HRRZI U,(TT)
02100 MOVEM B,SVBBB#
02200
02300 MOVEI Y,2(L)
02400 MOVEI XD,DBUF+1
02500 SKIPL A,INIX ;WHERE DO WE START
02600 JRST MAYBON
02700 SUBI A,43
02800 IDIV A,[-44]
02900 HRLOI X,XD
03000 SOJA A,SETB
03100
03200 MAYBON: ADDI A,43
03300 IDIVI A,44
03400 CAILE A,LBUFL
03500 JRST OFFRT
03600 MOVE X,A
03700 SETZ A,
03800 HRLI X,Y
03900 JRST SETB
04000
04100 OFFRT: MOVE X,[XD,,LBUFL]
04200 SUBI A,LBUFL
04300 SETB: MOVE B,INIX
04400 IDIVI B,44
04500 MOVSI B,400000
04600 MOVN C,C
04700 ROT B,(C)
04800 POPJ P,
04900
05000 POPJ1: AOS (P)
05100 CPOPJ: POPJ P,
05200
05300 LFT: -=100
05400 RT: =1700
05500 BOT: -=1229
05600 TOP: =2971
05700 OFFX: -=921
05800 OFFY: =1700
05900 NOROT: 0
06000 SVX: 0
06100 SVY: 0
06200 SVPEN: 0
06300 X1: 0
06400 Y1: 0
06500 3
06600 CLIP: SKIPE ZLFT
06700 JRST CLIPX
06800 CAMGE 15,XLFT ;LOOK FOR LEFTMOST POINT.
06900 MOVEM 15,XLFT
07000 CLIPX: MOVE CX# ;5 X1=CX
07100 MOVEM X1#
07200 MOVE CY# ; Y1=CY
07300 MOVEM Y1#
07400 MOVE SVY ; CY=Y2 (SVY)
07500 MOVEM CY
07600 MOVEM 15,CX ; CX=X2 (SVX)
07700 ALLOUT: MOVE LFT ; - FOR OUT OF BOUNDS
07800 CAMLE X1
07900 CAMG SVX
08000 SKIPA
08100 JRST ENOUT
08200 MOVE RT
08300 CAMGE X1
08400 CAML SVX
08500 SKIPA
08600 JRST ENOUT
08700 MOVE BOT
08800 CAMLE Y1
08900 CAMG SVY
09000 SKIPA
09100 JRST ENOUT ;ALL OUT OF BOUNDS. GO GET ANOTHER POINT
09200 MOVE TOP
09300 CAMGE Y1
09400 CAML SVY
09500 JRST ALLIN ;JRST AA2
09600 JRST ENOUT ;SETZ
09700
09800 ALLIN: MOVE 13,X1
09900 CAML 13,LFT ;X1 IS IN AC13 FOR ALX
10000 CAMLE 13,RT
10100 JRST ALX ;**** JRA 16,4(16)
10200 MOVE 14,SVX
10300 CAML 14,LFT
10400 CAMLE 14,RT
10500 JRST ALX ;**** JRA 16,4(16)
10600 MOVE Y1
10700 CAML BOT ;Y1 IS IN AC0 FOR ALX
10800 CAMLE TOP
10900 JRST ALX ;**** JRA 16,4(16)
11000 MOVE 15,SVY
11100 CAML 15,BOT
11200 CAMLE 15,TOP
11300 JRST ALX
11400 MOVEM 14,X3 ;X3=SVX ;V400
11500 MOVEM 15,Y3 ;Y3=SVY NOW ALL INBOUNDS
11600 PUSHJ P,VECOU
11700 JRST ENOUT ; GO GET ANOTHER POINT
11800
11900 ALX: PUSHJ P,SAVAC ;SAVE ALL AC'S.
12000 CAMN SVY ;MOVE Y1 ;IF(Y1.EQ.Y2)GO TO V50
12100 JRST V50
12200 CAME 13,SVX ;MOVE 13,X1 ;IF(X1.NE.X2)GO TO V60
12300 JRST V60
12400 JSA 16,STRT
12500 JUMP Y1
12600 JUMP SVY ;Y2
12700 JUMP BOT
12800 JUMP TOP
12900 JRST V300
13000
13100 V50: JSA 16,STRT
13200 JUMP X1
13300 JUMP SVX
13400 JUMP LFT
13500 JUMP RT
13600 JRST V300
13700 V60: JSA 16,CL
13800 JUMP X1
13900 JUMP SVX
14000 JUMP Y1
14100 JUMP SVY ;Y2
14200 JUMP W1#
14300 JUMP W2#
14400 JUMP Z1#
14500 JUMP Z2#
14600 JUMP LFT
14700 JUMP RT
14800 YYOUT: MOVE 1,BOT
14900 CAMLE 1,Y1
15000 CAMG 1,SVY
15100 SKIPA
15200 JRST AA1 ;JRST YYY1
15300 MOVE 1,TOP
15400 CAMGE 1,Y1
15500 CAML 1,SVY
15600 JRST CLXX
15700 AA1: PUSHJ P,GETAC ;GET BACK AC'S
15800 JRST ENOUT ;SKIP THIS VECTOR
15900 CLXX: JSA 16,CL
16000 JUMP Z1#
16100 JUMP Z2#
16200 JUMP W1#
16300 JUMP W2#
16400 JUMP Y1 ;Y1
16500 JUMP SVY ;Y2
16600 JUMP X1 ;X1
16700 JUMP SVX ;X2
16800 JUMP BOT
16900 JUMP TOP
17000 V300: MOVE 1,SVPEN ;IF(K.EQ.3)GO TO 400;; JRST V300
17100 CAIN 1,3
17200 JRST V400
17300 MOVE 2,X1 ; IF(X1.NE.X3)GO TO 500
17400 CAME 2,X3# ; IF(Y1.EQ.Y3)GO TO 400
17500 JRST V500 ;500 CALL VECOU(MM,LL,JX)
17600 MOVE 3,Y1 ;400 X3=X2
17700 CAMN 3,Y3# ; Y3=Y2
17800 JRST V400
17900 V500: MOVE SVX
18000 MOVEM X3
18100 MOVE SVY
18200 MOVEM Y3
18300 MOVEM 1,SVPN#
18400 MOVEM 2,SVX
18500 MOVE 3,Y1
18600 MOVEM 3,SVY
18700 MOVEI 3
18800 MOVEM SVPEN
18900 PUSHJ P,GETAC ; CALL VECOU(MM,LL,JX)
19000 PUSHJ P,VECOU ; MAKE AN INVISIBLE VECTOR
19100 PUSHJ P,SAVAC
19200 MOVE X3
19300 MOVEM SVX ;GET BACK READ X,Y
19400 MOVE Y3
19500 MOVEM SVY
19600 MOVE SVPN
19700 MOVEM SVPEN
19800 JRST V401
19900 V400: MOVE SVX
20000 MOVEM X3
20100 MOVE SVY
20200 MOVEM Y3
20300 V401: PUSHJ P,GETAC
20400 PUSHJ P,VECOU
20500 JRST ENOUT ; GO TO 1
20600 CL: 0
20700 MOVE 10,@(16) ;X1
20800 MOVE 11,@1(16) ;X2
20900 MOVE 15,11
21000 SUB 15,10
21100 FLTR 15,15 ;R
21200 MOVE 14,@3(16) ;Y2
21300 SUB 14,@2(16) ;Q=(Y2-Y1)/(X2-X1)
21400 FLTR 14,14
21500 FDVR 14,15 ;Q
21600 QX: MOVE 1,10 ;W1=X1
21700 CAMGE 10,@10(16) ;IF(X1.LT.LFT)W1=LFT
21800 MOVE 1,@10(16)
21900 CAMLE 10,@11(16) ;IF(X1.GT.RT)W1=RT
22000 MOVE 1,@11(16) ;W1 IS AC1
22100 W1X: MOVEM 1,@4(16)
22200 SUB 1,10 ;W1-X1
22300 FLTR 1,1
22400 FMPR 1,14 ;*Q
22500 MOVE [0.5]
22600 SKIPGE 1
22700 MOVNS
22800 FADR 1,0 ;ROUNDOFF
22900 KIFIX 1,1
23000 ADD 1,@2(16) ;+Y1
23100 MOVEM 1,@6(16)
23200 Z1X: MOVE 1,11 ;W2=X2
23300 CAMGE 11,@10(16)
23400 MOVE 1,@10(16)
23500 CAMLE 11,@11(16)
23600 MOVE 1,@11(16) ;W2 IS AC1
23700 MOVEM 1,@5(16)
23800 W2X: SUB 1,11 ;X2-W2
23900 FLTR 1,1
24000 FMPR 1,14 ;*Q
24100 MOVE [0.5]
24200 SKIPGE 1
24300 MOVNS
24400 FADR 1,0 ;ROUNDOFF
24500 KIFIX 1,1
24600 ADD 1,@3(16) ;Y2-Q*(X2-W2)
24700 MOVEM 1,@7(16) ;Z2
24800 Z2X: JRA 16,12(16)
24900
25000 STRT: 0
25100 MOVE 1,@2(16) ;CALL STRT(X1,X2,LFT,RT)
25200 MOVE 2,@3(16) ; NOW CHECK RIGHT (OR TOP) SIDE.
25300 CAMG 1,@(16)
25400 JRST ST1
25500 MOVEM 1,@(16)
25600 JRST ST3
25700 ST1: CAMLE 1,@1(16)
25800 MOVEM 1,@1(16)
25900 ST2: CAML 2,@(16)
26000 JRST ST3
26100 MOVEM 2,@(16)
26200 JRA 16,4(16)
26300 ST3: CAMGE 2,@1(16)
26400 MOVEM 2,@1(16)
26500 JRA 16,4(16)
26600
00100 PLOT: HRR C,IBUF+1
00200 MOVN E,1(C) ;FIX FOR NO WDCNT
00300 PLOTX: MOVSI E,(E)
00400 HRR E,IBUF+1
00500 PLOT1: MOVE 14,2(E)
00600 LSHC 14,-10
00700 ASH 15,-34
00800 JUMPG 15,NORSET ;NEXT FOR RESET OF COORDS TO 0,0 (SVPEN=-1)
00900 LSHC 14,-16
01000 ASH 15,-26
01100 MOVN 14,15 ;TOP=TOP-Y2
01200 ADDM 14,TOP
01300 ADDM 14,BOT ;BOT=BOT-Y2
01400 ADDM 15,OFFX
01500 SKIPE NOROT ;IF(NOROT)OFFY=OFFY+Y2
01600 ADDM 15,OFFY
01700 JRST ENOUT ;GO GET ANOTHER POINT
01800
01900 NORSET: MOVEM 15,SVPEN# ;GET PEN CODE - NO RESET
02000 ;; MOVM A,15
02100 LSHC 14,-16
02200 ASH 15,-26
02300 SSSS: MOVEM 15,SVY# ;GET Y
02400 LSHC 14,-16
02500 ASH 15,-26
02600 MOVEM 15,SVX# ;GET X
02700 JRST CLIP
02800
02900 VECOU: AOS NOVECS ;COUNTS VECTORS
03000 MOVE 14,OFFY ;IF(NOROT)GO TO VEC1 IF SIZE 2.1-2.6
03100 SKIPE NOROT#
03200 JRST VEC1
03300 MOVE 13,SVY ;N=Y+OFFX
03400 ADD 13,OFFX
03500 SUB 14,SVX ;K2=OFFY-X
03600 MOVEM 14,SVY ;Y=K2
03700 MOVEM 13,SVX
03800 JRST VEC2
03900 VEC1: ADDB 14,SVY ;Y=Y+OFFY
04000 VEC2: MOVE A,SVPEN ;GET BACK PEN CODE
04100 MOVE 15,SVY ;X=N
04200 SUB 15,YY
04300 MOVEM 15,SVYSB# ;SAVE Y DIFF
04400 IMULI 15,LBUFL+1
04500 ADD 15,Y
04600 CAMGE 15,[=262144] ;2↑18
04700 SKIPG 15 ;IF(AC15.LT.0.OR.AC15.GT.2↑18-1)SKIP THIS POINT
04800 POPJ P, ;JRST ENOUT ;GO ON TO NEXT POINT, THIS WON'T FIT IN 1/2 WD.
04900 YOK: MOVEM 15,SVYOD# ;SAVE NEW Y
05000 CAIGE 15,(L) ;OFF BOTTOM
05100 JRST LOSE
05200 CAIL 15,-LBUFL-1(U) ;OFF TOP
05300 JRST LOSE
05400 MOVE 15,SVX
05500 SUB 15,XX
05600 MOVE 0,15 ;0 HAS X DIFF
05700 HRRZ 16,X
05800 IMULI 16,44 ;TIMES BITS INA WORD
05900 JFFO B,.+1
06000 ADD 16,C ;PLUS REMAINDER EQ OLD X
06100 SUB 16,15
06200 JUMPL 16,LOSEX
06300 CAILE 16,=4427
06400 JRST LOSEX
06500 SKIPE OOBFLG# ;CK IF ALREADY OOB
06600 JRST OOBAR
06700 FIXUP: CAIE A,1 ;FIXUP WHAT?
06800 HRRM A,PENN
06900 HRR A,PENN ;SAME PEN IF 1
07000 CAIN A,3
07100 JRST PENUP ;PENUP IF 3
07200 MOVE C,SVYSB ;Y DIFF
07300 IORM B,@X ;MARK NOW X Y
07400 ;FIND DIRECTION
07500 JUMPE NORMX ;VERT OR NO MOVE
07600 JUMPL MVLFT ;LEFT
07700 JUMPE C,NRT ;HORZ
07800 JUMPL C,MVDWN ;DOWN
07900 CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
08000 JRST XCHA
08100
08200 SETZ 14, ;↓↓ MOVE UP AND RIGHT
08300 TLNE C,200000
08400 JRST .+4
08500 LSH C,1
08600 TRO C,1
08700 AOJA 14,.-4
08800 SUBI 14,=34
08900 IDIV C,0
09000 MOVNS 14
09100 LSH C,(14)
09200 SETZ 15,
09300 INLOOP: ADD 15,C
09400 TLZE 15,200000
09500 ADDI Y,LBUFL+1
09600 SKIPGE B
09700 SOJ X,
09800 ROT B,1
09900 IORM B,@X
10000 SOJG INLOOP
10100 JRST DONXT
10200
00100 XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
00200 TLNE 0,200000
00300 JRST .+4
00400 LSH 0,1
00500 TRO 0,1
00600 AOJA 14,.-4
00700 SUBI 14,=34
00800 IDIV 0,C
00900 MOVNS 14
01000 LSH 0,(14)
01100 SETZ 15,
01200 INLOO: ADD 15,0
01300 TLZN 15,200000
01400 JRST MVUP
01500 SKIPGE B
01600 SOJ X,
01700 ROT B,1
01800 MVUP: ADDI Y,LBUFL+1
01900 IORM B,@X
02000 SOJG C,INLOO
02100 JRST DONXT
02200
02300 MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
02400 CAMLE C,0
02500 JRST XCHA2 ;JUMP IF YDIFF > XDIFF
02600 SETZ 14,
02700 TLNE C,200000
02800 JRST .+4
02900 LSH C,1
03000 TRO C,1
03100 AOJA 14,.-4
03200 SUBI 14,=34
03300 IDIV C,0
03400 MOVNS 14
03500 LSH C,(14)
03600 SETZ 15,
03700 INLOP: ADD 15,C
03800 TLZE 15,200000
03900 SUBI Y,LBUFL+1
04000 SKIPGE B
04100 SOJ X,
04200 ROT B,1
04300 IORM B,@X
04400 SOJG INLOP
04500 JRST DONXT
04600
04700 XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
04800 TLNE 0,200000
04900 JRST .+4
05000 LSH 0,1
05100 TRO 0,1
05200 AOJA 14,.-4
05300 SUBI 14,=34
05400 IDIV 0,C
05500 MOVNS 14
05600 LSH 0,(14)
05700 SETZ 15,
05800 INOOP: ADD 15,0
05900 TLZN 15,200000
06000 JRST MVEX
06100 SKIPGE B
06200 SOJ X,
06300 ROT B,1
06400 MVEX: SUBI Y,LBUFL+1
06500 IORM B,@X
06600 SOJG C,INOOP
06700 JRST DONXT
06800
06900 NRT: JUMPL B,GOOP ;HORZ RIGHT
07000 TOOT: ROT B,1
07100 IORM B,@X
07200 SOJG 0,NRT
07300 JRST DONXT
07400 GOOP: SOJ X,
07500 CAIGE 0,44
07600 JRST TOOT
07700 IDIVI 0,44
07800 SETOM @X
07900 SOJ X,
08000 SOJG 0,.-2
08100 HRR 0,1
08200 JUMPN 0,TOOT
08300 AOJ X,
08400 JRST DONXT
08500
08600 NLFT: MOVMS 0 ;HORZ LEFT
08700 ROT B,-1
08800 JUMPL B,ROOT
08900 WOOP: IORM B,@X
09000 SOJG 0,.-3
09100 JRST DONXT
09200 ROOT: AOJ X,
09300 CAIGE 0,44
09400 JRST WOOP
09500 IDIVI 0,44
09600 SETOM @X
09700 AOJ X,
09800 SOJG 0,.-2
09900 HRR 0,1
10000 JUMPN 0,WOOP
10100 SOJ X,
10200 ROT B,1
10300 JRST DONXT
10400 ;;NORMX: JUMPE C,NOMOVE ;NO DIFF
10500 NORMX: SKIPN C ;;JUMPE C,ENOUT ;NO DIFF
10600 POPJ P,
10700 JUMPL C,MDOWN ;MOVE VERT DOWN
10800 MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
10900 IORM B,@X
11000 SOJG C,MUP
11100 JRST DONXT
11200 MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
11300 IORM B,@X
11400 AOJL C,MDOWN
11500 DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
11600 MOVEM 4,XX
11700 NXTY: MOVE 4,SVY
11800 MOVEM 4,YY
11900 ;;NOMOVE: SKIPL SVPEN ;****** THIS DONE AT 'PLOT' NOW
12000 ;; JRST ENOUT
12100 ;; SETZM XX ;IF NEW LOCO
12200 ;; SETZM YY
12300 POPJ P,
12400
12500 ;;ENOUT: SKIPN CLIPX ;IF CLIPX.EQ.0 WE ARE INSERTING INVIS VEC.
12600 ;; JRST CLIPZ
12700 ENOUT: AOBJN E,PLOT1 ;GET NEXT
12800 JRST OUTER
12900
00100 MVLFT: MOVMS 0 ;MOVE LEFT THEN RIGHT
00200 MOVMS 15
00300 JUMPE C,NLFT
00400 HRR Y,SVYOD
00500 IDIVI 15,44
00600 ADD X,15
00700 XEND: SOJL 16,DUN
00800 ROT B,-1
00900 JUMPGE B,XEND
01000 AOJ X,
01100 JRST XEND
01200 DUN: MOVEM X,XX ;SAVE NEW X POS
01300 MOVEM B,YY
01400 IORM B,@X
01500 JUMPL C,MVLD
01600 CAMLE C,0
01700 JRST XCHA3
01800 SETZ 14, ;MOVE LEFT UP
01900 TLNE C,200000
02000 JRST .+4
02100 LSH C,1
02200 TRO C,1
02300 AOJA 14,.-4
02400 SUBI 14,=34
02500 IDIV C,0
02600 MOVNS 14
02700 LSH C,(14)
02800 SETZ 15,
02900 ILOOP: ADD 15,C
03000 TLZE 15,200000
03100 SUBI Y,LBUFL+1
03200 SKIPGE B
03300 SOJ X,
03400 ROT B,1
03500 IORM B,@X
03600 SOJG ILOOP
03700 JRST BFOR
03800
03900 XCHA3: SETZ 14,
04000 TLNE 0,200000
04100 JRST .+4
04200 LSH 0,1
04300 TRO 0,1
04400 AOJA 14,.-4
04500 SUBI 14,=34
04600 IDIV 0,C
04700 MOVNS 14
04800 LSH 0,(14)
04900 SETZ 15,
05000 ILOP: ADD 15,0
05100 TLZN 15,200000
05200 JRST DOQ
05300 SKIPGE B
05400 SOJ X,
05500 ROT B,1
05600 DOQ: SUBI Y,LBUFL+1
05700 IORM B,@X
05800 SOJG C,ILOP
05900 JRST BFOR
06000
06100 MVLD: MOVMS C ;MOVE LEFT DOWN
06200 CAMLE C,0
06300 JRST XCHA4
06400 SETZ 14,
06500 TLNE C,200000
06600 JRST .+4
06700 LSH C,1
06800 TRO C,1
06900 AOJA 14,.-4
07000 SUBI 14,=34
07100 IDIV C,0
07200 MOVNS 14
07300 LSH C,(14)
07400 SETZ 15,
07500 LOOP: ADD 15,C
07600 TLZE 15,200000
07700 ADDI Y,LBUFL+1
07800 SKIPGE B
07900 SOJ X,
08000 ROT B,1
08100 IORM B,@X
08200 SOJG LOOP
08300 JRST BFOR
08400
08500 XCHA4: SETZ 14,
08600 TLNE 0,200000
08700 JRST .+4
08800 LSH 0,1
08900 TRO 0,1
09000 AOJA 14,.-4
09100 SUBI 14,=34
09200 IDIV 0,C
09300 MOVNS 14
09400 LSH 0,(14)
09500 SETZ 15,
09600 LOP: ADD 15,0
09700 TLZN 15,200000
09800 JRST DOP
09900 SKIPGE B
10000 SOJ X,
10100 ROT B,1
10200 DOP: ADDI Y,LBUFL+1
10300 IORM B,@X
10400 SOJG C,LOP
10500
10600 BFOR: HRR Y,SVYOD ;RESTORE PEN TO NEW PEN
10700 MOVE X,XX
10800 MOVE B,YY
10900 JRST DONXT
11000
00100 OOBAR: SETZM OOBFLG ; GET HERE IF ALL READY OOB
00200 AOSG SSS ; THIS IS FOR THE FIRST OOB FROM MP
00300 JRST FIXUP ;
00400 PENUP: HRR Y,SVYOD ; PEN IS UP GET NEW Y
00500 JUMPE 15,NXTY ;IF VERT
00600 JUMPL 15,PULFT ;IF LEFT
00700 CAIGE 15,44 ;↓↓MOVE UP PEN RIGHT TO NEW X
00800 JRST XLOOP
00900 IDIVI 15,44
01000 SUB X,15
01100 HRR 15,16
01200 XLOOP: SOJL 15,DONXT
01300 SKIPGE B
01400 SOJ X,
01500 ROT B,1
01600 JRST XLOOP
01700
01800 PULFT: MOVMS 15 ;↓↓MOVE UP PEN LEFT TO NEW X
01900 CAIGE 15,44
02000 JRST OOO
02100 IDIVI 15,44
02200 ADD X,15
02300 HRR 15,16
02400 OOO: SOJL 15,DONXT
02500 ROT B,-1
02600 JUMPGE B,OOO
02700 AOJ X,
02800 JRST OOO
02900
03000 LOSEX: SETOM OOBFLG ;OOB X
03100 SKIPE POOBX
03200 JRST PENUP
03300 SETOM POOBX
03400 MOVE 14,SVPEN ;IF(SVPEN.EQ.3)GO TO PENUP
03500 CAIN 14,3
03600 JRST PENUP
03700 PUSHJ P,DETCHK
03800 PUSHJ P,XERR
03900 PUSHJ P,ERRPNT
04000 ASCIZ / POINT OUT OF BOUNDS, /
04100 JUMPL 16,[PUSHJ P,ERRPNT
04200 ASCIZ/-X/
04300 JRST PENUP]
04400 PUSHJ P,ERRPNT
04500 ASCIZ/+X/
04600 JRST PENUP
04700
04800 LOSE: SETOM OOBFLG ;OOB Y
04900 SKIPE POOBY
05000 JRST LOBAC ;JRST PENUP
05100 SETOM POOBY
05200 ; MOVE 14,SVPEN ;IF(SVPEN.EQ.3)GO TO PENUP
05300 ; CAIN 14,3
05400 ; JRST PENUP
05500 PUSHJ P,DETCHK
05600 PUSHJ P,XERR
05700 PUSHJ P,ERRPNT
05800 ASCIZ / POINT OUT OF BOUNDS, /
05900 CAIGE 15,(L)
06000 JRST [ PUSHJ P,ERRPNT
06100 ASCIZ/-Y/
06200 JRST LOBAC] ;PENUP]
06300 PUSHJ P,ERRPNT
06400 ASCIZ/+Y/
06500 LOBAC: LSHC 14,-16
06600 ASH 15,-26
06700 MOVEM 15,SVX
06800 SUB 15,XX
06900 JRST PENUP
07000
07100 DECOUT: IDIVI T,=10 ;DEC TTY OUT
07200 HRLM TT,(P)
07300 SKIPE T
07400 PUSHJ P,DECOUT
07500 HLRZ TT,(P)
07600 ADDI TT,60
07700 ROT TT,-7
07800 MOVEM TT,.+2
07900 PUSHJ P,ERRPNT
08000 0
08100 POPJ P,
08200
08300 ERRPNT: HRRZ TT,(P) ;ERROR TTY OUT
08400 MOVEM TT,PNTR
08500 MOVEI TT,LINE
08600 TTYMES TT,
08700 JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
08800 OUTSTR @PNTR
08900 OUTSTR[ASCIZ/
09000 /]
09100 JRST .+1]
09200 POP P,TT
09300 HRL TT,(TT)
09400 TLNE TT,376
09500 AOJA TT,.-2
09600 JRST 1(TT)
09700
09800 XERR: PUSHJ P,ERRPNT ;DET TTY OUT
09900 ASCIZ/
10000 MESSAGE FROM X WORKING ON /
10100 MOVE TT,FILNAM
10200 PUSHJ P,SIXOUT
10300 PUSHJ P,ERRPNT
10400 ASCIZ/./
10500 HLLZ TT,FILEXT
10600 PUSHJ P,SIXOUT
10700 PUSHJ P,ERRPNT
10800 ASCIZ/[/
10900 MOVE TT,FILPPN
11000 PUSHJ P,SIXOUT
11100 PUSHJ P,ERRPNT
11200 ASCIZ/] : /
11300 POPJ P,
11400
11500 SIXOUT: JUMPE TT,CPOPJ ;SIXBIT OUT
11600 SETZ T,
11700 LSHC T,6
11800 ADDI T,40
11900 PUSH P,TT
12000 ROT T,-7
12100 MOVEM T,.+2
12200 PUSHJ P,ERRPNT
12300 0
12400 POP P,TT
12500 JRST SIXOUT
12600
12700 DETCHK: SETOM DET# ;CK FOR DET JOB
12800 GETLIN DET
12900 HRRES DET
13000 SKIPL DET
13100 AOS (P)
13200 POPJ P,
13300
00100 XXOUT: SKIPN SPREAD
00200 JRST NOXGP
00300
00400 HRRZ T,XGPPTR
00500 ADDI T,LBUFL+1
00600 HRRZ C,SVBBB
00700
00800 SKIPG SPREAD
00900 JRST NINE
01000
01100 XLINE4: HRLI T,-LBUFL
01200
01300 XSHFT4: MOVE A,2(T)
01400 MOVE B,3(T)
01500 ROTC A,1
01600 ORM A,2(T)
01700 AOBJN T,XSHFT4
01800 AOJ T,
01900 SOJG C,XLINE4
02000
02100 HRRZ T,XGPPTR
02200 HRRZ B,SVBBB
02300
02400 YLINE4: HRLI T,-LBUFL
02500
02600 YSHFT4: MOVE A,LBUFL+3(T)
02700 ORM A,2(T)
02800 AOBJN T,YSHFT4
02900 AOJ T, ;Bump past control word.
03000 SOJG B,YLINE4
03100
03200 SOS SPREAD ;IF(SPREAD.EQ.1)GO WRITE FILE
03300 SKIPG SPREAD
03400 JRST NOXGP
03500 S16: HRRZ T,XGPPTR ;START 16 DOTS
03600 ADDI T,LBUFL+1 ;THAT IS, DO BOTH 4 DOT AND 9 DOT ROUTINES.
03700 HRRZ C,SVBBB
03800
03900 NINE: HRLI T,-LBUFL
04000
04100 XSHFT9: MOVE A,2(T)
04200 MOVE B,3(T)
04300 ROTC A,1
04400 ORM A,2(T)
04500 ROTC A,1
04600 ORM A,2(T)
04700 AOBJN T,XSHFT9
04800 AOJ T,
04900 SOJG C,NINE
05000
05100 HRRZ T,XGPPTR
05200 HRRZ B,SVBBB
05300
05400 YLINE9: HRLI T,-LBUFL
05500
05600 YSHFT9: MOVE A,LBUFL+LBUFL+4(T)
05700 OR A,LBUFL+3(T)
05800 ORM A,2(T)
05900 AOBJN T,YSHFT9
06000 AOJ T,
06100 SOJG B,YLINE9
06200 NOXGP: PUSHJ P,DETCHK
06300 PUSHJ P,XERR
06400 SETOM ZLFT ;FLAG FOR FINDING LEFTMOST POINT.
06500 JRST OUTFIL
06600
06700 NODEL: RELEASE DSK,
06800 SKIPGE DET
06900 PUSHJ P,XERR
07000 PUSHJ P,ERRPNT
07100 ASCIZ/ALL DONE!
07200 /
07300 PUSHJ P,CORDWN
07400 CALLI 12 ;LEAVE
07500
07600 XNIT: 417
07700 'VRN '
07800 0
07900 XGPPTR: BLOCK 2
08000
08100 IFN LSTBIT-1,<
08200 XFIX: MOVE A,[LSTBIT-1]
08300 HRRZ C,JOBREL
08400 HRRZ D,XGPPTR
08500 XFIXL: ANDCAM A,LBUFL-1+2(D)
08600 ADDI D,LBUFL+1
08700 CAIGE D,(C)
08800 JRST XFIXL
08900 POPJ P,
09000 >
09100 CORDWN: MOVE T,JOBFF
09200 SUBI T,1
09300 CALLI T,11
09400 JRST 4,.
09500 POPJ P,
09600
00100 OUTFIL: OUTSTR [ASCIZ/
00200 /]
00300 JSA 16,TYPINT
00400 JUMP NOVECS
00500 OUTSTR [ASCIZ/ VECTORS IN THIS SEGMENT.
00600 /]
00700 MOVE U,OUTNAM
00800 ROT U,6 ;CHANGE SINGLE SIXBIT CHAR TO ASCIZ
00900 ADDI U,40
01000 OUTSTR [ASCIZ/ --- WRITING /]
01100 OUTCHR U
01200 OUTSTR [ASCIZ/.VRN ---
01300 /]
01400 ;; OUTSTR [ASCIZ/ WRITING .VRN FILE --
01500 ;;/]
01600 MOVE U,XGPPTR
01700 ADDI U,=12100 ;SKIP 1ST 1/2 INCH (121 WDS * 100 LINES)
01800 HLRO T,U
01900 MOVNS T
02000 IDIVI T,LBUFL+1 ;DIVIDE WDCNT BY WDS IN LINE (120+1)
02100 CAMLE T,SEG1 ;LESS THAN 1400 SCAN LINES
02200 MOVE T,SEG1 ;NO, LIMIT IT TO 1400
02300 MOVEM T,HEADER+4 ;PUT AWAY FOR VARIAN PROGRAM.
02400 IMULI T,LBUFL+1 ;RESET THE WDCNT
02500 OUTF2: TRZ T,177
02600 HRRZI A,200(T)
02700 ADDI A,(U)
02800 CORE A,
02900 JRST OUTFIL
03000 MOVNS T
03100 HLL T,U ;FIRST WD IS WC-200,-WC
03200 MOVEM T,1(U)
03300 HRLI U,-200(T)
03400 SETZ 10,
03500
03600 UDP: JRST NOUDP ;CHANGE IN DDT TO JFCL TO WRITE ON UDP1
03700 OPEN [17↔'UDP1 '↔0]
03800 JRST 4,.
03900 ENTER OUTNAM
04000 CAIA
04100 JRST .+5 ;SKIP NEXT IF WRITING ON UDP1
04200
04300 NOUDP: OPEN [17↔'DSK '↔0] ;CHANGE DEVICE NAME TO UDP1 IN SIXBIT
04400 JRST 4,.
04500 ENTER OUTNAM
04600 CAIA
04700 MOVEI 0,HEADER
04800 SUBI 0,1
04900 MOVEM 0,COM
05000 MOVNI 0,200
05100 HRLM 0,COM
05200 OUTPUT COM
05300 STATZ 0,740000
05400 HALT ;ERROR <WRITE ERROR>
05500 OUTPUT U
05600 RELEAS
05700 ;; MOVE NOVECS
05800 ;; CAIGE =1000 ;IF FEWER THAN 1000 VECTORS ASSUME ALL DONE.
05900 ;; JRST NODEL ;ALL DONE
06000 MOVE OUTNAM
06100 ADD [10000,,0] ;GO UP THE ALPHABET
06200 MOVEM OUTNAM
06300 AOS 1,KSEG ;UP THE SEGMENT NUMBER
06400 MOVEM 1,ISEG
06500 JRST BEGX ;TEMPORARY
06600 COM: 0
06700 0
06800 HEADER: 0
06900 0
07000 =121 ;MUST BE 1 MORE THAN LBUFL ON PAGE 2.
07100 0
07200 =1600 ;NUMBER OF SCAN LINES IN FILE. SET UP AT OUTFIL+=10
07300 0
07400 117 ;WORD 2 +DECIMAL 37 -- NOT NEEDED
07500 0
07600 0
07700 0
07800
07900 TYPINT: 0 ;CALL TYPINT(INTEGER)
08000 SKIPGE 1,@(16) ;TYPES OUT INTEGERS
08100 OUTCHR ["-"]
08200 MOVMS 1
08300 PUSHJ 17,DECREC
08400 JRA 16,1(16)
08500 DECREC: IDIVI 1,=10
08600 HRLM 2,(17)
08700 SKIPE 1
08800 PUSHJ 17,DECREC
08900 HLRZ 1,(17)
09000 ADDI 1,"0"
09100 OUTCHR 1
09200 POPJ 17,
09300
09400 TYPFLT: 0 ;CALL TYPFLT(F)
09500 MOVM 4,@(16) ;NEEDS ACS 1→5 **** PRINTS ONLY TO 2 DECIS.
09600 KIFIX 3,@(16)
09700 FMPR 4,[100.0] ;TO GET THINGS TO RT. OF DEC.
09800 ;;*** CAUSES 199.997 TO PRINT AS 199 ** FADR 4,[0.5] ;FOR ROUND OFF.
09900 KIFIX 4,4
10000 IDIVI 4,=100 ;REMAINDER IS IN AC6
10100 JUMPN 3,TYPFL1 ;JUMP IF LFT SIDE .NE.0
10200 SKIPGE @(16) ;IS ORIGINAL NUM. NEG?
10300 OUTCHR ["-"] ;YES
10400 OUTCHR ["0"]
10500 JRST .+3 ;PRINT A ZERO AND SKIP NEXT CALL
10600 TYPFL1: JSA 16,TYPINT
10700 JUMP 3
10800 SKIPN 5 ;PRINT NO MORE IF ONLY ZEROS
10900 JRA 16,1(16)
11000 OUTCHR ["."] ;DECIMAL PT.
11100 CAIGE 5,=10
11200 OUTCHR["0"] ;FOR ZERO AFTER DECI
11300 MOVE 3,5
11400 IDIVI 3,=10
11500 SKIPE 4 ;LOOK AT REMAINDER, JUMP IF NON-ZERO
11600 MOVE 3,5 ;ELSE PRINT ALL 3 DIGITS
11700 DECI: JSA 16,TYPINT
11800 JUMP 3
11900 JRA 16,1(16)
00100 ;CORUP
00200
00300 CORUP:
00400
00500 REPEAT 0,< OLD WAY - FLUSHED BY REG 1-3-76
00600
00700 HRRZ B,JOBCNI
00800 CAIE B,20000
00900 DISMIS
01000 MOVE A,JOBTPC
01100 MOVEM A,IPC+1
01200 UWAIT
01300 DEBREAK
01400 >;END REPEAT 0
01500
01600 BUST: MOVEM 1,SVONE#
01700 MOVEM 2,SVTWO#
01800 MOVEM TT,SVTTT#
01900 MOVE 1,JOBCNI ;REG GET APR CONI BITS
02000 TRNN 1,20000 ;REG IS THERE AN MPV?
02100 JRST NOMPV ;REG NO
02200 HRRZ 1,JOBREL ;OLD CORE SIZE
02300 MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
02400 HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
02500 ADDI 1,16000
02600 ;; ADDI 1,10000 ;GET ANOTHER 8K
02700 MOVE TT,1
02800 CORE 1,
02900 PUSHJ P,CORLUZ
03000 HRRZ 1,JOBREL
03100 SETZM -1(2)
03200 BLT 2,(1) ;ZERO NEW CORE
03300 MOVE 1,SVONE
03400 MOVE 2,SVTWO
03500 MOVE TT,SVTTT
03600
03700 REPEAT 0,<
03800 INTJEN IPC
03900 >
04000
04100 JRST 2,@JOBTPC ;REG THIS IS HOW TO DISMISS OLD INTERRUPT
04200
04300 NOMPV: OUTSTR [ASCIZ/UNEXPECTED INTERRUPT?
04400 /]
04500 JRST 2,@JOBTPC
04600
04700 CORLUZ: MOVE T,TT
04800 LSH T,-12
04900 PUSH P,T
05000 PUSHJ P,DETCHK
05100 PUSHJ P,XERR
05200 POP P,T
05300 PUSHJ P,DECOUT
05400 PUSHJ P,ERRPNT
05500 ASCIZ / K OF CORE NEEDED!
05600 /
05700 SKIPGE DET
05800 CALLI 12
05900 JRST ASKLEN
06000
06100 FNF: PUSHJ P,DETCHK ;FILE NOT FOUND
06200 PUSHJ P,XERR
06300 PUSHJ P,ERRPNT
06400 ASCIZ /LOOKUP FAILED.
06500 /
06600 SKIPGE DET
06700 CALLI 12
06800 JRST BEG ;JRST FILIN
06900
00100 SPRD: PUSHJ P,GETNAM
00200
00300 GOX: SETZM SPRED
00400 CAME A,[SIXBIT/4/] ;FOR * FOUR
00500 JRST CKSEMI
00600 AOS SPRED
00700 POPBAC: PUSHJ P,INCHLF
00800 POPJ P,
00900 CKSEMI: CAME A,[SIXBIT/9/] ;FOR * NINE
01000 JRST CKDEFA
01100 SETOM SPRED
01200 JRST POPBAC
01300 CKDEFA: CAMN A,[SIXBIT/16/] ;TYPE 16 FOR 16 DOTS
01400 MOVEM A,SPRED ;NOW SPRED IS BIG POSITIVE NUM
01500 JRST POPBAC
01600 ;***** TYPE '4' FOR 2X2 DOTS, TYPE '9' FOR 3X3 DOTS, 16 FOR 4X4.********
01700
01800 FRD: MOVSI A,'PLT' ;FILE SCAN
01900 MOVEM A,FILEXT
02000 PUSHJ P,GETNAM
02100 ONEDOT: SKIPN A
02200 MOVE A,['PLT ']
02300 MOVEM A,FILNAM
02400 CAIE C,"."
02500 JRST NOEXT
02600 PUSHJ P,GETNAM
02700 MOVEM A,FILEXT
02800 NOEXT: CAIE C,"["
02900 JRST FRDX
03000 PUSHJ P,GETP
03100 HRLZM A,FILPPN
03200 PUSHJ P,GETP
03300 HRRM A,FILPPN
03400 FRDX: INCHRW C
03500 CAIE C,12
03600 JRST FRDX
03700 POPJ P,
03800
03900 RNUM: INCHWL C ;NUM SCAN
04000 CAIN C,15
04100 JRST RNUM
04200 CAIN C,12
04300 POPJ P,
04400 AOS (P)
04500 MOVEI A,
04600 SETZM SIGN
04700 CAIN C,"-"
04800 JRST [ PUSHJ P,RNUML
04900 SETOM SIGN
05000 MOVN A,A
05100 POPJ P,]
05200 CAIN C,"+"
05300 RNUML: INCHWL C
05400 CAIL C,"0"
05500 CAILE C,"9"
05600 JRST RNUMX
05700 IMULI A,12
05800 ADDI A,-"0"(C)
05900 JRST RNUML
06000
06100 RNUMX: CAIN C,15
06200 INCHRW C
06300 POPJ P,
06400
00100 GETNAM: MOVEI A, ;FILE SCAN
00200 MOVE B,[440600,,A]
00300 GETNML: PUSHJ P,RCH
00400 POPJ P,
00500 SUBI C,40
00600 TLNE B,770000
00700 IDPB C,B
00800 JRST GETNML
00900
01000 GETP: MOVEI A,
01100 GETPL: PUSHJ P,RCH
01200 POPJ P,
01300 TRNE A,770000
01400 JRST GETPL
01500 LSH A,6
01600 ADDI A,-40(C)
01700 JRST GETPL
01800
01900 RCH: INCHWL C
02000 CAIN C,42
02100 JRST RCHQ
02200 CAIE C,11
02300 CAIN C," "
02400 JRST RCH
02500 CAIE C,"."
02600 CAIN C,","
02700 POPJ P,
02800 CAIE C,"["
02900 CAIN C,"]"
03000 POPJ P,
03100 RCHQR: CAIGE C,40
03200 POPJ P,
03300 CAIL C,"a"
03400 CAILE C,"z"
03500 CAIA
03600 SUBI C,40
03700 JRST POPJ1
03800
03900 RCHQ: INCHWL C
04000 JRST RCHQR
04100
04200 NAMGET: OUTSTR [ASCIZ/TYPE 1ST OUTPUT NAME (USE SINGLE LETTER ONLY. <CR>=A.VRN) /]
04300 SETZM OUTEXT+1
04400 SETZM OUTPPN
04500 MOVSI A,'VRN'
04600 MOVEM A,OUTEXT
04700 PUSHJ P,GETNAM
04800 SKIPN A
04900 MOVE A,['A '] ;['PLT ']
05000 MOVEM A,OUTNAM
05100 CAIE C,"."
05200 JRST NOEXTN
05300 PUSHJ P,GETNAM
05400 MOVEM A,OUTEXT
05500 NOEXTN: CAIE C,"["
05600 JRST FFDX
05700 PUSHJ P,GETP
05800 HRLZM A,OUTPPN
05900 PUSHJ P,GETP
06000 HRRM A,OUTPPN
06100 FFDX: INCHRW C
06200 CAIE C,12
06300 JRST FFDX
06400 POPJ P,
06500
00100 FILNAM: 0 ;GLOPS OF JUNK
00200 FILEXT: 0
00300 0
00400 FILPPN: 0
00500 OUTNAM: 0 ;GLOPS OF JUNK
00600 OUTEXT: 0
00700 0
00800 OUTPPN: 0
00900
01000 LKENT: BLOCK 4
01100
01200 XGSNAM: 0
01300 XGSEXT: 0
01400 0
01500 XGSPPN: 0
01600
01700 IBUF: BLOCK 3
01800
01900 BITTAB: FOR I←43,0,-1{1⊗I
02000 }
02100 BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
02200
02300 DBUF: BLOCK LBUFL+2
02400
02500 PDL: BLOCK LPDL
02600
02700 END BEG